home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / prim / sound.el.z / sound.el
Encoding:
Text File  |  1998-05-21  |  6.0 KB  |  182 lines
  1. ;;; sound.el --- Loading sound files in XEmacs
  2.  
  3. ;; Copyright (C) 1985, 1986, 1992, 1993, 1994 Free Software Foundation, Inc.
  4. ;; Copyright (C) 1995 Tinker Systems and INS Engineering Corp.
  5.  
  6. ;; This file is part of XEmacs.
  7.  
  8. ;; XEmacs is free software; you can redistribute it and/or modify it
  9. ;; under the terms of the GNU General Public License as published by
  10. ;; the Free Software Foundation; either version 2, or (at your option)
  11. ;; any later version.
  12.  
  13. ;; XEmacs is distributed in the hope that it will be useful, but
  14. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  15. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  16. ;; General Public License for more details.
  17.  
  18. ;; You should have received a copy of the GNU General Public License
  19. ;; along with XEmacs; see the file COPYING.  If not, write to the 
  20. ;; Free Software Foundation, 59 Temple Place - Suite 330,
  21. ;; Boston, MA 02111-1307, USA.
  22.  
  23. ;;; Synched up with: Not in FSF.
  24. (defgroup sound nil
  25.   "Configure XEmacs sounds and properties"
  26.   :group 'environment)
  27.  
  28. (defcustom sound-default-alist
  29.       '((default        :sound bass)
  30.     (undefined-key    :sound drum)
  31.     (undefined-click    :sound drum)
  32.     ;; beginning-of-buffer or end-of-buffer errors.
  33.     (buffer-bound    :sound drum)
  34.     ;; buffer-read-only error
  35.     (read-only            :sound drum)
  36.     ;; non-interactive function or lambda called
  37.     (command-error    :sound bass)
  38.     (y-or-n-p        :sound quiet)
  39.     (yes-or-no-p        :sound quiet)
  40.     (auto-save-error    :sound whip :volume 100)
  41.     (no-completion    :sound whip)
  42.     (isearch-failed    :sound quiet)
  43.     (isearch-quit    :sound bass)
  44.     ;; QUIT: sound generated by ^G and it's variants.
  45.     (quit        :sound quiet :volume 75)
  46.     ;; READY: time-consuming task has completed...  compile,
  47.     ;; cvs-update, etc.
  48.     (ready        :sound cuckoo)
  49.     ;; WARP: XEmacs has changed the selected-window or frame
  50.     ;; asynchronously...  Especially when it's done by an
  51.     ;; asynchronous process filter.  Perhaps by a debugger breakpoint
  52.     ;; has been hit?
  53.     (warp        :sound yeep :volume 75)
  54.     ;; ALARM: used for reminders...
  55.     (alarm        :sound cuckoo :volume 100)
  56.     )
  57.       "The alist of sounds and associated error symbols.
  58.  
  59.  Used to set sound-alist in load-default-sounds."
  60.       :group 'sound
  61.       :type '(repeat
  62.           (group (symbol :tag "Name")
  63.              (checklist :inline t
  64.                 :greedy t
  65.                 (group :inline t
  66.                        (const :format "" :value :sound)
  67.                        (symbol :tag "Sound"))
  68.                 (group :inline t
  69.                        (const :format "" :value :volume)
  70.                        (integer :tag "Volume"))
  71.                 (group :inline t
  72.                        (const :format "" :value :pitch)
  73.                        (integer :tag "Pitch"))
  74.                 (group :inline t
  75.                        (const :format "" :value :duration)
  76.                        (integer :tag "Duration"))))))
  77.  
  78. (defcustom sound-load-alist 
  79.   '((load-sound-file "drum-beep.au"    'drum)
  80.     (load-sound-file "quiet-beep.au"    'quiet)
  81.     (load-sound-file "bass-snap.au"    'bass 80)
  82.     (load-sound-file "whip.au"        'whip 70)
  83.     (load-sound-file "cuckoo.au"        'cuckoo)
  84.     (load-sound-file "yeep.au"        'yeep)
  85.     (load-sound-file "hype.au"        'hype 100)
  86.     )
  87.   "A list of calls to load-sound-file to be processed by load-default-sounds. 
  88.  
  89.   Reference load-sound-file for more information."
  90.   
  91.   :group 'sound
  92.   :type '(repeat  (sexp :tag "Sound")
  93.           ))
  94.  
  95. (defcustom default-sound-directory (concat data-directory "sounds/")
  96.   "Default directory to load a sound file from."
  97.   :group 'sound
  98.   :type 'directory
  99.   )
  100.  
  101. (defcustom sound-ext ""
  102.   "Filename extensions to complete sound file name with. If more than one 
  103.    extension is used, they should be separated by \":\". "
  104.   :group 'sound
  105.   :type 'string)
  106.  
  107. (defcustom default-sound-directory-list ( list default-sound-directory )
  108.   "List of directories which to search for sound files"
  109.   :group 'sound
  110.   :type '(repeat directory )
  111.   )
  112.  
  113. ;;;###autoload
  114. (or sound-alist
  115.     ;; these should be silent until sounds are loaded
  116.     (setq sound-alist '((ready nil) (warp nil))))
  117.  
  118. ;;;###autoload
  119. (defun load-sound-file (filename sound-name &optional volume)
  120.   "Read in an audio-file and add it to the sound-alist.
  121.  
  122. You can only play sound files if you are running on display 0 of the
  123. console of a machine with native sound support or running a NetAudio
  124. server and XEmacs has the necessary sound support compiled in.
  125.  
  126. The sound file must be in the Sun/NeXT U-LAW format, except on Linux,
  127. where .wav files are also supported by the sound card drivers."
  128.   (interactive "fSound file name: \n\
  129. SSymbol to name this sound: \n\
  130. nVolume (0 for default): ")
  131.   (unless (symbolp sound-name)
  132.     (error "sound-name not a symbol"))
  133.   (unless (or (null volume) (integerp volume))
  134.     (error "volume not an integer or nil"))
  135.   (let (buf
  136.     data
  137.     (file (locate-file filename  default-sound-directory-list  sound-ext)))
  138.     (unless file
  139.       (error "Couldn't load sound file %s" filename))
  140.     (unwind-protect
  141.     (save-excursion
  142.       (set-buffer (setq buf (get-buffer-create " *sound-tmp*")))
  143.       (buffer-disable-undo (current-buffer))
  144.       (erase-buffer)
  145.       (let ((coding-system-for-read 'binary))
  146.         (insert-file-contents  file))
  147.       (setq data (buffer-string))
  148.       (erase-buffer))
  149.       (and buf (kill-buffer buf)))
  150.     (let ((old (assq sound-name sound-alist)))
  151.       ;; some conses in sound-alist might have been dumped with emacs.
  152.       (if old (setq sound-alist (delq old (copy-sequence sound-alist)))))
  153.     (setq sound-alist (cons
  154.             (purecopy
  155.              (nconc (list sound-name)
  156.                 (if (and volume (not (eq 0 volume)))
  157.                     (list ':volume volume))
  158.                    (list ':sound data)))
  159.             sound-alist)))
  160.   sound-name)
  161.  
  162. ;;;###autoload
  163. (defun load-default-sounds ()
  164.   "Load and install some sound files as beep-types, using
  165. `load-sound-file'.  This only works if you're on display 0 of the
  166. console of a machine with native sound support or running a NetAudio
  167. server and XEmacs has the necessary sound support compiled in."
  168.   (interactive)
  169.   ;; #### - this should do NOTHING if the sounds can't be played.  
  170.   (message "Loading sounds...")
  171.   (setq sound-alist nil)
  172.   ;; this is where the calls to load-sound-file get done
  173.   (mapc 'eval sound-load-alist)
  174.   (setq sound-alist
  175.     (append sound-default-alist
  176.         sound-alist))
  177.   (message "Loading sounds...done")
  178.   ;; (beep nil 'quiet)
  179.   )
  180.  
  181. ;; sound.el ends here.
  182.